home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 004 / astr0106.arc / ASTRO106.BAS < prev    next >
BASIC Source File  |  1986-02-23  |  12KB  |  352 lines
  1. 10 DEFDBL A-Z
  2. 12 WT=1721027!
  3. 14 YT=2415020!
  4. 16 XX=6.6460656#
  5. 18 ZZ=2400.051262#
  6. 20 DEF FNRAD(X)=X*.0174532928#
  7. 30 DEF FNDEG(X)=X*57.2957787#
  8. 40 DEF FNARCSIN(X)=ATN(X/SQR(1-X^2))
  9. 50 DEF FNARCCOS(X)=1.570796-ATN(X/SQR(1-X^2))
  10. 60 Q=0
  11. 70 CLS:LOCATE 4,7:PRINT "Select the Planet desired:"
  12. 80 LOCATE 6,15:PRINT "1 - Mercury"
  13. 90 LOCATE 8,15:PRINT "2 - Venus"
  14. 100 LOCATE 10,15:PRINT "3 - Mars"
  15. 110 LOCATE 12,15:PRINT "4 - Jupiter"
  16. 120 LOCATE 14,15:PRINT "5 - Saturn"
  17. 130 LOCATE 16,15:PRINT "6 - Neptune"
  18. 140 LOCATE 18,15:PRINT "7 - Uranus"
  19. 150 LOCATE 21,7:INPUT "Type number selection here: ",P
  20. 160 IF P=1 THEN GOSUB 10000
  21. 170 IF P=2 THEN GOSUB 10100
  22. 180 IF P=3 THEN GOSUB 10200
  23. 190 IF P=4 THEN GOSUB 10300
  24. 200 IF P=5 THEN GOSUB 10400
  25. 210 IF P=6 THEN GOSUB 10600
  26. 220 IF P=7 THEN GOSUB 10500
  27. 230 CLS:LOCATE 8,7:PRINT "For What Date?"
  28. 240 LOCATE 10,15:INPUT "Month (##): ",MM
  29. 250 UT=MM
  30. 260 LOCATE 12,15:INPUT "Day (##)  : ",DD
  31. 270 LOCATE 14,15:INPUT "Year(####): ",YEAR
  32. 275 CLS
  33. 280 IF MM<2 THEN MM=(((MM-1)*63)/2)
  34. 290 IF MM>1 THEN MM=(((MM+1)*30.6)-63)
  35. 300 DAYS=MM+DD+1:DAYS%=INT(DAYS):RDY%=DAYS%
  36. 310 YRNUMBER=YEAR-1980
  37. 320 DAYSINCE=YRNUMBER*365
  38. 330 IF YRNUMBER>0 AND YRNUMBER<6 THEN DAYSINCE=DAYSINCE+1
  39. 340 IF YRNUMBER>5 AND YRNUMBER<10 THEN DAYSINCE=DAYSINCE+2
  40. 350 IF YRNUMBER>9 AND YRNUMBER<14 THEN DAYSINCE=DAYSINCE+3
  41. 360 IF YRNUMBER>13 AND YRNUMBER<18 THEN DAYSINCE=DAYSINCE+4
  42. 370 IF YRNUMBER>17 AND YRNUMBER<22 THEN DAYSINCE=DAYSINCE+5
  43. 380 IF YRNUMBER>21 AND YRNUMBER<26 THEN DAYSINCE=DAYSINCE+6
  44. 390 IF YRNUMBER>25 AND YRNUMBER<30 THEN DAYSINCE=DAYSINCE+7
  45. 400 DAYS%=DAYS%+DAYSINCE
  46. 410 LOCATE 16,15:INPUT "Daylight Savings Time (Y/N)??? ",DL$
  47. 420 LOCATE 18,15:INPUT "What is the latitude?  ",PHI
  48. 430 'PLANET CALCULATIONS
  49. 440 I1=FNRAD(I1)
  50. 450 NPLANET=(360/365.2422)*(DAYS%/T1)
  51. 460 IF NPLANET>0 AND NPLANET<360 THEN GOTO 480
  52. 470 IF NPLANET<0 THEN NPLANET=NPLANET+360:GOTO 460
  53. 475 IF NPLANET>360 THEN NPLANET=NPLANET-360:GOTO 460
  54. 480 MPLANET=FNRAD(NPLANET+E1-W1)
  55. 490 MPLANET=SIN(MPLANET)
  56. 500 LPLANET=NPLANET+((360/3.1415927#)*C1*MPLANET)+E1
  57. 510 IF LPLANET>0 AND LPLANET<360 THEN GOTO 540
  58. 520 IF LPLANET<0 THEN LPLANET=LPLANET+360:GOTO 510
  59. 530 IF LPLANET>360 THEN LPLANET=LPLANET-360:GOTO 510
  60. 540 VPLANET=FNRAD(LPLANET-W1)
  61. 550 VPLANET=COS(VPLANET)
  62. 560 RPLANET=(A1*(1-C1^2))/(1+C1*VPLANET)
  63. 570 'EARTH POSITIONAL CALCULATIONS
  64. 580 NEARTH=(360/365.2422)*(DAYS%/1.00004)
  65. 590 IF NEARTH>0 AND NEARTH<360 THEN GOTO 620
  66. 600 IF NEARTH<0 THEN NEARTH=NEARTH+360
  67. 610 IF NEARTH>360 THEN NEARTH=NEARTH-360
  68. 620 MEARTH=SIN(FNRAD(NEARTH+98.83354#-102.596403#))
  69. 630 LEARTH=NEARTH+((360/3.1415927#)*.016718*MEARTH)+98.83354#
  70. 640 IF LEARTH>0 AND LEARTH<360 THEN GOTO 670
  71. 650 IF LEARTH<0 THEN LEARTH=LEARTH+360:GOTO 640
  72. 660 IF LEARTH>360 THEN LEARTH=LEARTH-360:GOTO 640
  73. 670 VEARTH=COS(FNRAD(LEARTH-102.596403#))
  74. 680 REARTH=.9997205/(1+.016718*VEARTH)
  75. 690 PSI1=(SIN(FNRAD(LPLANET-L1))*SIN(I1))
  76. 700 PSI=FNARCSIN(PSI1)
  77. 710 YCOORD=(SIN(FNRAD(LPLANET-L1))*COS(I1))
  78. 720 XCOORD=COS(FNRAD(LPLANET-L1))
  79. 730 TCOORD=FNDEG(ATN(YCOORD/XCOORD))
  80. 740 'QUADRANT CALCULATIONS
  81. 750 GOSUB 11000
  82. 760 LPRIME=TCOORD+L1
  83. 770 IF LPRIME>360 THEN LPRIME=LPRIME-360:Q=1
  84. 780 RPRIME=RPLANET*COS(PSI)
  85. 790 IF P>2 THEN GOTO 15000
  86. 800 L3=FNRAD(LEARTH-LPRIME)
  87. 810 ACAP=FNDEG(ATN((RPRIME*SIN(L3))/(REARTH-(RPRIME*COS(L3)))))
  88. 820 LAMBDA=180+LEARTH+ACAP
  89. 830 IF LAMBDA<0 THEN LAMBDA=LAMBDA+360
  90. 840 IF LAMBDA>360 THEN LAMBDA=LAMBDA-360
  91. 850 L4=FNRAD(LAMBDA-LPRIME):LB=FNRAD(LPRIME-LEARTH)
  92. 860 BETA=ATN((RPRIME*TAN(PSI)*SIN(L4))/(REARTH*SIN(LB)))
  93. 870 LAMBDAD=FNRAD(LAMBDA):E4=FNRAD(23.441884#)
  94. 880 'ROUTINE NO. 27
  95. 890 DEC2=(SIN(BETA)*COS(E4))+(COS(BETA)*SIN(E4)*SIN(LAMBDAD))
  96. 900 DEC1=FNARCSIN(DEC2)
  97. 910 DEC=FNDEG(DEC1)
  98. 920 YCORD=((SIN(LAMBDAD)*COS(E4))-(TAN(BETA)*SIN(E4)))
  99. 930 XCORD=COS(LAMBDAD)
  100. 940 F1=FNDEG(ATN(YCORD/XCORD)):PRINT "LINE 940 F1= ";F1
  101. 950 IF F1<0 THEN F1=F1+360:PRINT "LINE 950 F1= ";F1
  102. 960 F2=F1-LAMBDA:PRINT "LINE 960 F2= ";F2
  103. 970 IF ABS(F2)>180 THEN F1=F1-180:PRINT "LINE 970 F1= ";F1
  104. 972 IF P=1 AND F1<0 THEN F1=F1+360
  105. 975 IF P=1 THEN GOTO 1010
  106. 980 IF F1<0 THEN F1=F1+360
  107. 990 TEMP=180-ABS(F2):PRINT "LINE 990 TEMP = ";TEMP
  108. 1000 IF TEMP<1 OR TEMP>-1 THEN F1=F1+180:PRINT "LINE 1000 F1= ";F1
  109. 1005 IF F1>360 THEN F1=F1-180
  110. 1010 RIGHTASCENSION=F1/15
  111. 1020 IF RIGHTASCENSION>24 THEN RIGHTASCENSION=RIGHTASCENSION-12
  112. 1030 IF Q=1 THEN RIGHTASCENSION=RIGHTASCENSION-12
  113. 1040 L6=FNRAD(LPLANET):L7=FNRAD(LEARTH)
  114. 1050 'DIST FROM EARTH
  115. 1060 P8=SQR(REARTH^2+RPLANET^2-(2*REARTH*RPLANET)*COS(FNRAD(LPLANET-LEARTH)))
  116. 1070 DISTFMEARTH=P8*93000000#
  117. 1080 'LIGHT TIME
  118. 1090 T8=P8*.1386
  119. 1100 LTHR%=INT(T8):TA=T8-LTHR%:W=TA*60:LTMIN%=INT(W):I=W-LTMIN%:J=I*60:LTSEC%=INT(J+.5)
  120. 1110 T6=S1/P8
  121. 1210 D8=LAMBDA-LPLANET
  122. 1220 D8=FNRAD(D8)
  123. 1230 'PHASE
  124. 1240 PHASE=(1/2)*(1+COS(D8))
  125. 1250 M1=(RPLANET*P8)/(B1*SQR(PHASE))
  126. 1260 'MAGNITUDE
  127. 1270 MAGNITUDE=5*(LOG(M1)/LOG(10))-27.49
  128. 1271 IF P=4 THEN MAGNITUDE=MAGNITUDE-.6
  129. 1272 IF P=5 THEN MAGNITUDE=MAGNITUDE-.6
  130. 1280 PHI=FNRAD(PHI)
  131. 1290 TB=SIN(DEC1)/COS(PHI)
  132. 1300 IF TB>1! OR TB<-1! THEN GOSUB 12800:GOTO 8000
  133. 1310 MR=FNARCCOS(TB)
  134. 1320 MR=FNDEG(MR)
  135. 1330 Z3=360-MR
  136. 1340 T4=(-(TAN(PHI))*TAN(DEC1))
  137. 1350 T4=FNARCCOS(T4)
  138. 1360 T4=FNDEG(T4):T4=T4*(1/15):RISINGST=24+RIGHTASCENSION-T4
  139. 1370 IF RISINGST>23.99 THEN RISINGST=RISINGST-24
  140. 1380 SETTINGST=RIGHTASCENSION+T4
  141. 1390 IF SETTINGST>23.99 THEN SETTINGST=SETTINGST-24
  142. 1400 GOSUB 13020
  143. 1410 PTM=(DAYS%*.0657098)-SPS#
  144. 1420 IF PTM<0 THEN PTM=PTM+24
  145. 1430 RISINGMTIME=RISINGST-PTM:IF RISINGMTIME<0 THEN RISINGMTIME=RISINGMTIME+24
  146. 1440 SETTINGMTIME=SETTINGST-PTM:IF SETTINGMTIME<0 THEN SETTINGMTIME=SETTINGMTIME+24
  147. 1450 RISING=RISINGMTIME*.99727:SETTING=SETTINGMTIME*.99727
  148. 1460 IF DL$="Y" THEN RISING=RISING+1:SETTING=SETTING+1
  149. 1470 IF RISING>23.99 THEN RISING=RISING-24
  150. 1480 IF RISING<0 THEN RISING=RISING+24:GOTO 1470
  151. 1490 IF SETTING>23.99 THEN SETTING=SETTING-24
  152. 1500 IF SETTING<0 THEN SETTING=SETTING+24:GOTO 1490
  153. 8000 LPRINT:LPRINT:LPRINT:LPRINT:LPRINT:LPRINT
  154. 8005 LPRINT TAB(25)NAM$;"    DATE: ";UT;"/";DD;"/";YEAR
  155. 8010 LPRINT
  156. 8015 LPRINT TAB(30)"Equatorial Coordinates"
  157. 8016 LPRINT
  158. 8017 LPRINT STRING$(79,196)
  159. 8050 LPRINT TAB(26)"HRS/DEGREES" TAB(45)"MINUTES" TAB(60)"SECONDS"
  160. 8070 N=0:G=0
  161. 8080 IF N=1 THEN X=DEC
  162. 8090 IF N=0 THEN X=RIGHTASCENSION
  163. 8110 XT%=INT(X):XA=X-XT%:A=XA*60:B%=INT(A):C=A-B%:D=C*60:E%=INT(D+.5)
  164. 8130 IF E%=60 THEN B%=B%+1:E%=0
  165. 8150 IF B%=60 THEN XT%=XT%+1
  166. 8155 IF N=1 THEN GOSUB 14000
  167. 8165 IF N=1 THEN GOTO 8210
  168. 8170 IF N=0 THEN LPRINT TAB(5)"RIGHT ASCENSION" TAB(33)XT% TAB(47)B% TAB(62)E%
  169. 8180 LPRINT:GOTO 8230
  170. 8210 IF N=1 THEN LPRINT TAB(5)"DECLINATION    " TAB(33)XT% TAB(47)B% TAB(62)E%
  171. 8230 N=N+1
  172. 8240 IF N<2 THEN GOTO 8080
  173. 8250 LPRINT:LPRINT:LPRINT
  174. 8251 LPRINT
  175. 8255 LPRINT TAB(5)NAM$;" WILL RISE AND SET AT THESE TIMES:"
  176. 8256 LPRINT
  177. 8257 LPRINT TAB(14)"HOUR" TAB(30)"MINUTES" TAB(50)"SECONDS"
  178. 8258 LPRINT
  179. 8260 GOSUB 14300
  180. 8270 LPRINT:LPRINT
  181. 8272 LPRINT STRING$(79,196)
  182. 8280 LPRINT TAB(10) "PLANETARY DATA ON EARTH AND ";NAM$
  183. 8282 LPRINT STRING$(79,196)
  184. 8290 LPRINT:LPRINT:LPRINT
  185. 8300 LPRINT USING "    EARTH'S DISTANCE TO SUN:   ###.############## ASTRONOMICAL UNITS";REARTH
  186. 8310 LPRINT
  187. 8320 LPRINT TAB(5)NAM$;:LPRINT TAB(15) USING "DISTANCE TO SUN: ###.##############";RPLANET;:LPRINT " AU"
  188. 8330 LPRINT
  189. 8340 LPRINT TAB(5) USING "DISTANCE FROM EARTH:       ###.############## ASTRONOMICAL UNITS";P8
  190. 8350 LPRINT
  191. 8360 LPRINT TAB(5) USING "DISTANCE FROM EARTH:   ###############.#### MILES";DISTFMEARTH
  192. 8370 LPRINT
  193. 8380 LPRINT TAB(5) USING "LIGHT TIME:                 ## HRS ## MIN ## SECS";LTHR%,LTMIN%,LTSEC%
  194. 8390 LPRINT
  195. 8400 LPRINT TAB(5) USING "MAGNITUDE:                 ###.#########";MAGNITUDE
  196. 8410 LPRINT
  197. 8420 LPRINT USING "    PHASE:                     ###.#########";PHASE
  198. 8425 LPRINT
  199. 8430 LPRINT TAB(5) USING "ANGULAR SIZE:               ##.#########  ARC SECONDS";T6
  200. 8435 LPRINT CHR$(12);
  201. 9999 END
  202. 10000 NAM$="MERCURY"
  203. 10002 T1=.24085
  204. 10005 E1=231.2973
  205. 10010 W1=77.1442128#
  206. 10015 C1=.2056306
  207. 10020 A1=.3870986
  208. 10025 I1=7.0043579#
  209. 10030 L1=48.0941733#
  210. 10035 S1=6.74
  211. 10040 B1=1.918E-06
  212. 10050 RETURN
  213. 10100 NAM$="VENUS"
  214. 10105 T1=.61521
  215. 10110 E1=355.73352#
  216. 10120 W1=131.2895792#
  217. 10130 C1=.0067826
  218. 10140 A1=.7233316
  219. 10150 I1=3.394435
  220. 10160 L1=76.4997524#
  221. 10170 S1=16.92
  222. 10180 B1=1.721E-05
  223. 10190 RETURN
  224. 10200 NAM$="MARS"
  225. 10205 T1=1.88089
  226. 10210 E1=126.30783#
  227. 10220 W1=335.6908166#
  228. 10230 C1=.0933865
  229. 10240 A1=1.5236883#
  230. 10250 I1=1.8498011#
  231. 10260 L1=49.4032001#
  232. 10270 S1=9.359999
  233. 10280 B1=4.539E-06
  234. 10290 RETURN
  235. 10300 NAM$="JUPITER"
  236. 10305 T1=11.86224
  237. 10310 E1=146.966365#
  238. 10320 W1=14.0095493#
  239. 10330 C1=.0484658
  240. 10340 A1=5.202561
  241. 10350 I1=1.3041819#
  242. 10360 L1=100.2520175#
  243. 10370 S1=196.74
  244. 10380 B1=.0001994
  245. 10390 RETURN
  246. 10400 NAM$="SATURN"
  247. 10405 T1=29.45771
  248. 10410 E1=165.322242#
  249. 10420 W1=92.6653974#
  250. 10430 C1=.0556155
  251. 10440 A1=9.554747
  252. 10450 I1=2.4893741#
  253. 10460 L1=113.4888341#
  254. 10470 S1=165.6
  255. 10480 B1=.000174
  256. 10490 RETURN
  257. 10500 NAM$="URANUS"
  258. 10505 T1=84.01247
  259. 10510 E1=228.0708551#
  260. 10520 W1=172.7363288#
  261. 10530 C1=.0463232
  262. 10540 A1=19.21814
  263. 10550 I1=.7729895
  264. 10560 L1=73.8768642#
  265. 10570 S1=65.8
  266. 10580 B1=7.768E-05
  267. 10590 RETURN
  268. 10600 NAM$="NEPTUNE"
  269. 10605 T1=164.79558#
  270. 10610 E1=260.3578998#
  271. 10620 W1=47.8672148#
  272. 10630 C1=.0090021
  273. 10640 A1=30.10957
  274. 10650 I1=1.7716017#
  275. 10660 L1=131.5606494#
  276. 10670 S1=62.2
  277. 10680 B1=7.597E-05
  278. 10690 RETURN
  279. 11000 IF XCOORD>0 AND YCOORD>0 THEN GOSUB 11100
  280. 11005 IF XCOORD<0 AND YCOORD>0 THEN GOSUB 11200
  281. 11010 IF XCOORD>0 AND YCOORD<0 THEN GOSUB 11300
  282. 11020 IF XCOORD<0 AND YCOORD<0 THEN GOSUB 11400
  283. 11030 RETURN
  284. 11100 IF TCOORD>0 AND TCOORD<90 THEN RETURN
  285. 11105 IF TCOORD<-180 THEN TCOORD=TCOORD+360:GOTO 11100
  286. 11110 IF TCOORD<0 THEN TCOORD=TCOORD+180:GOTO 11100
  287. 11120 IF TCOORD>90 THEN TCOORD=TCOORD-180:GOTO 11100
  288. 11130 RETURN
  289. 11200 IF TCOORD>90 AND TCOORD<180 THEN RETURN
  290. 11210 IF TCOORD<0 THEN TCOORD=TCOORD+180:GOTO 11200
  291. 11220 IF TCOORD>180 THEN TCOORD=TCOORD-180:GOTO 11200
  292. 11230 IF TCOORD<90 THEN TCOORD=TCOORD+90:GOTO 11200
  293. 11240 RETURN
  294. 11300 IF TCOORD<360 AND TCOORD>270 THEN RETURN
  295. 11310 IF TCOORD<-180 THEN TCOORD=TCOORD+360:GOTO 11300
  296. 11320 IF TCOORD<0 THEN TCOORD=TCOORD+360:GOTO 11300
  297. 11330 IF TCOORD<180 THEN TCOORD=TCOORD+180:GOTO 11300
  298. 11340 IF TCOORD>360 THEN TCOORD=TCOORD-180:GOTO 11300
  299. 11350 RETURN
  300. 11400 IF TCOORD<270 AND TCOORD>180 THEN RETURN
  301. 11410 IF TCOORD<0 THEN TCOORD=TCOORD+360:GOTO 11400
  302. 11420 IF TCOORD<90 THEN TCOORD=TCOORD+180:GOTO 11400
  303. 11430 IF TCOORD>360 THEN TCOORD=TCOORD-180:GOTO 11400
  304. 11440 RETURN
  305. 12800 CLS:LOCATE 10,7:PRINT NAM$;" does not rise or set here!"
  306. 12810 RETURN
  307. 13020 MTT=UT:UT=1
  308. 13030 IF RDY%>1 THEN DTD%=1
  309. 13040 'COMPUTATION FOR SPS
  310. 13050 D8%=INT(1):F8#=D8%-1-.5
  311. 13060 J8%=-INT(7*(INT((UT+9)/12)+YEAR)/4)
  312. 13070 S8=SGN(UT-9):A8=ABS(UT-9)
  313. 13080 J9%=INT(YEAR+S8*INT(A8/7))
  314. 13090 J9%=-INT((INT(J9%/100)+1)*3/4)
  315. 13100 J8#=J8%+INT(275*UT/9)+D8%+1*J9%
  316. 13110 JD#=J8#+WT+2*1+367*YEAR
  317. 13120 IF F8#>=0 THEN 13140
  318. 13130 F8#=F8#+1:JD#=JD#-1
  319. 13140 J9#=JD#+F8#-1
  320. 13150 S5#=J9#-YT
  321. 13160 T5#=S5#/(365.25*100)
  322. 13170 R8#=XX+(ZZ*T5#)+(2.581E-05*T5#^2)
  323. 13180 SPS1#=R8#-(24*(YEAR-1900))
  324. 13190 SPS#=24-SPS1#
  325. 13195 UT=MTT
  326. 13210 RETURN
  327. 13230 END
  328. 14000 IF DEC>0 THEN GOTO 14130
  329. 14110 X=ABS(DEC):XT%=INT(X):XA=X-XT%:XT%=XT%*-1:A=XA*60:B%=INT(A):C=A-B%:D=C*60:E%=INT(D+.5)
  330. 14120 G=1
  331. 14130 RETURN
  332. 14300 N=0
  333. 14310 IF N=1 THEN X=SETTING
  334. 14320 IF N=0 THEN X=RISING
  335. 14330 XT%=INT(X):XA=X-XT%:A=XA*60:B%=INT(A):C=A-B%:D=C*60:E%=INT(D+.5)
  336. 14340 IF E%=60 THEN B%=B%+1:E%=0
  337. 14360 IF B%=60 THEN XT%=XT%+1
  338. 14390 IF N=0 THEN LPRINT TAB(5)"RISING  " TAB(14)XT% TAB(30)B% TAB(50)E%
  339. 14410 IF N=1 THEN LPRINT TAB(5)"SETTING " TAB(14)XT% TAB(30)B% TAB(50)E%
  340. 14430 N=N+1
  341. 14440 IF N<2 THEN GOTO 14310
  342. 14450 RETURN
  343. 15000 L3=FNRAD(LPRIME-LEARTH)
  344. 15010 LAMBDAD=ATN((REARTH*SIN(L3))/(RPRIME-(REARTH*COS(L3))))
  345. 15020 LAMBDA=FNDEG(LAMBDAD):L4=LAMBDA+LPRIME
  346. 15030 IF L4<0 THEN L4=L4+360
  347. 15040 IF L4>360 THEN L4=L4-360
  348. 15050 LAMBDA=L4:LD=FNRAD(L4-LPRIME)
  349. 15060 BETA=ATN((RPRIME*TAN(PSI)*SIN(LD))/(REARTH*SIN(L3)))
  350. 15070 GOTO 870
  351. EN L4=L4-360
  352. 15050